Multimedia Dogs/Multimedia Dogs v2.0.iso/pc/demos/petdisc/mmpets1d.exe/MMPETS1D.DXR/00206_Database handlers.ls

Text File | 1995-10-06 | 9.5 KB | 292 lines

global gBreedDatabase, gBreedDatabaseCount, gBreedDatabaseByGroup, gBreedDatabaseByWorld, gBreedDatabaseByCode, gGalleryDatabase, gGalleryDatabaseCount, gQuizDatabase, gQuizDatabaseCount, gGlossaryDatabase, gGlossaryDatabaseCount

on initDatabases
  initBreedDatabase()
  initGalleryDatabase()
  initGlossaryDatabase()
  initQuizDatabase()
end

on getBreedIndex theCode
  repeat with i = 1 to gBreedDatabaseCount
    set theRecord to getAt(gBreedDatabase, i)
    if getAt(theRecord, 2) = theCode then
      return i
    end if
  end repeat
  alert("Bogus code for breed:" && theCode)
  return -1
end

on getBreedRecord theIndex
  if (theIndex > gBreedDatabaseCount) or (theIndex < 0) then
    return EMPTY
  else
    return getAt(gBreedDatabase, theIndex)
  end if
end

on getFieldDisplayName theRecord
  return getAt(theRecord, 1)
end

on getFieldBreedCode theRecord
  return getAt(theRecord, 2)
end

on getFieldGroupCode theRecord
  return getAt(theRecord, 3)
end

on getFieldProfile theRecord
  return getAt(theRecord, 4)
end

on genAll
  genBreedCode()
  genGalleryCode()
  genGlossaryCode()
  genQuizCode()
  genTopicsText()
end

on genBreedCode
  put "Generating initBreedDatabase()..."
  set fname to the pathName & "data:zsupport:database:breeds.txt"
  set theCastName to "BreedDatabaseCode"
  set file to FileIO(mnew, "read", fname)
  if not objectp(file) then
    alert("Fatal error: cannot read file" && fname)
    exit
  end if
  set skipString to TAB & RETURN & " "
  set breakString to TAB & RETURN
  set theDatabase to []
  repeat while 1
    set token to file(mReadToken, breakString, skipString)
    if token = EMPTY then
      exit repeat
    end if
    if char 1 of token = "#" then
      file(mReadLine)
      next repeat
    end if
    put "reading" && token
    set theRecord to [token]
    set token to file(mReadToken, breakString, skipString)
    append(theRecord, token)
    set token to file(mReadToken, breakString, skipString)
    append(theRecord, token)
    set theProfile to []
    repeat with i = 1 to 8
      set token to file(mReadToken, breakString, skipString)
      append(theProfile, value(token))
    end repeat
    append(theRecord, theProfile)
    append(theDatabase, theRecord)
  end repeat
  file(mdispose)
  put "Building indicies..."
  set codeIndex to makeIndex(theDatabase, 2)
  set groupIndex to makeIndex(theDatabase, 3)
  set theString to EMPTY
  set theString to theString & "-- This code was generated by genBreedCode()" & RETURN & RETURN
  set theString to theString & "global gBreedDatabase" & RETURN
  set theString to theString & "global gBreedDatabaseCount" & RETURN
  set theString to theString & "global gBreedDatabaseByCode" & RETURN
  set theString to theString & "global gBreedDatabaseByGroup" & RETURN & RETURN
  set theString to theString & "on initBreedDatabase" & RETURN & RETURN
  set theString to theString & "set gBreedDatabase =" && theDatabase & RETURN & RETURN
  set theString to theString & "set gBreedDatabaseCount = count(gBreedDatabase)" & RETURN & RETURN
  set theString to theString & "set gBreedDatabaseByCode  =" && codeIndex & RETURN & RETURN
  set theString to theString & "set gBreedDatabaseByGroup =" && groupIndex & RETURN & RETURN
  set theString to theString & "end" & RETURN
  set the scriptText of cast theCastName to theString
  put "Done."
  beep()
end

on genGalleryCode
  put "Generating initGalleryDatabase()..."
  set fname to the pathName & "data:zsupport:database:gallery.txt"
  set theCastName to "GalleryDatabaseCode"
  set file to FileIO(mnew, "read", fname)
  if not objectp(file) then
    alert("Fatal error: cannot read file" && fname)
    exit
  end if
  set skipString to TAB & RETURN & " "
  set breakString to TAB & RETURN
  set theDatabase to []
  repeat while 1
    set token to file(mReadToken, breakString, skipString)
    if token = EMPTY then
      exit repeat
    end if
    if char 1 of token = "#" then
      file(mReadLine)
      next repeat
    end if
    set theRecord to [token]
    set token to file(mReadToken, breakString, skipString)
    append(theRecord, token)
    append(theDatabase, theRecord)
  end repeat
  file(mdispose)
  set propList to [:]
  repeat with i = 1 to count(theDatabase)
    set theRecord to getAt(theDatabase, i)
    addProp(propList, getAt(theRecord, 1), [getAt(theRecord, 2), "gallery"])
  end repeat
  initBreedDatabase()
  repeat with i = 1 to gBreedDatabaseCount
    set theRecord to getAt(gBreedDatabase, i)
    addProp(propList, getFieldDisplayName(theRecord), [getFieldBreedCode(theRecord), getFieldGroupCode(theRecord)])
  end repeat
  sort(propList)
  set theList to []
  repeat with i = 1 to count(propList)
    set theRecord to getAt(propList, i)
    set theProp to getPropAt(propList, i)
    append(theList, [theProp, getAt(theRecord, 1), getAt(theRecord, 2)])
  end repeat
  set theString to EMPTY
  set theString to theString & "-- This code was generated by genGalleryCode()" & RETURN & RETURN
  set theString to theString & "global gGalleryDatabase" & RETURN
  set theString to theString & "global gGalleryDatabaseCount" & RETURN & RETURN
  set theString to theString & "on initGalleryDatabase" & RETURN & RETURN
  set theString to theString & "set gGalleryDatabase =" && theList & RETURN & RETURN
  set theString to theString & "set gGalleryDatabaseCount = count(gGalleryDatabase)" & RETURN & RETURN
  set theString to theString & "end" & RETURN
  set the scriptText of cast theCastName to theString
  put "Done."
  beep()
end

on genGlossaryCode
  put "Generating initGlossaryDatabase()..."
  set fname to the pathName & "data:zsupport:database:glossary.txt"
  set theCastName to "GlossaryDatabaseCode"
  set theListname to "GlossaryList"
  set file to FileIO(mnew, "read", fname)
  if not objectp(file) then
    alert("Fatal error: cannot read file" && fname)
    exit
  end if
  set skipString to TAB & RETURN & " "
  set breakString to TAB & RETURN
  set theDatabase to []
  set theList to EMPTY
  repeat while 1
    set token to file(mReadToken, breakString, skipString)
    if token = EMPTY then
      exit repeat
    end if
    if char 1 of token = "#" then
      file(mReadLine)
      next repeat
    end if
    put "reading" && token
    set theRecord to [token]
    if theList = EMPTY then
      set theList to theList & token
    else
      set theList to theList & RETURN & token
    end if
    set token to file(mReadToken, breakString, skipString)
    append(theRecord, munge(token))
    append(theDatabase, theRecord)
  end repeat
  file(mdispose)
  set theString to EMPTY
  set theString to theString & "-- This code was generated by genGlossaryCode()" & RETURN & RETURN
  set theString to theString & "global gGlossaryDatabase" & RETURN
  set theString to theString & "global gGlossaryDatabaseCount" & RETURN & RETURN
  set theString to theString & "on initGlossaryDatabase" & RETURN & RETURN
  set theString to theString & "set gGlossaryDatabase =" && theDatabase & RETURN & RETURN
  set theString to theString & "set gGlossaryDatabaseCount = count(gGlossaryDatabase)" & RETURN & RETURN
  set theString to theString & "end" & RETURN
  set the scriptText of cast theCastName to theString
  set the text of cast theListname to theList
  put "Done."
  beep()
end

on genQuizCode
  put "Generating initQuizDatabase()..."
  set fname to the pathName & "data:zsupport:database:quiz.txt"
  set theCastName to "QuizDatabaseCode"
  set file to FileIO(mnew, "read", fname)
  if not objectp(file) then
    alert("Fatal error: cannot read file" && fname)
    exit
  end if
  set skipString to TAB & RETURN & " "
  set breakString to TAB & RETURN
  set theDatabase to []
  repeat while 1
    set token to file(mReadToken, breakString, skipString)
    if token = EMPTY then
      exit repeat
    end if
    if char 1 of token = "#" then
      file(mReadLine)
      next repeat
    end if
    put "reading" && token
    set theRecord to []
    set token to file(mReadToken, breakString, skipString)
    append(theRecord, token)
    set token to file(mReadToken, breakString, skipString)
    append(theRecord, munge(token))
    append(theDatabase, theRecord)
  end repeat
  file(mdispose)
  set theString to EMPTY
  set theString to theString & "-- This code was generated by genQuizCode()" & RETURN & RETURN
  set theString to theString & "global gQuizDatabase" & RETURN
  set theString to theString & "global gQuizDatabaseCount" & RETURN & RETURN
  set theString to theString & "on initQuizDatabase" & RETURN & RETURN
  set theString to theString & "set gQuizDatabase =" && theDatabase & RETURN & RETURN
  set theString to theString & "set gQuizDatabaseCount = count(gQuizDatabase)" & RETURN & RETURN
  set theString to theString & "end" & RETURN
  set the scriptText of cast theCastName to theString
  put "Done."
  beep()
end

on makeIndex theDatabase, theKeyPosition
  set theIndexList to [:]
  repeat with i = 1 to count(theDatabase)
    set theRecord to getAt(theDatabase, i)
    set theKey to getAt(theRecord, theKeyPosition)
    set theList to getaProp(theIndexList, theKey)
    if voidp(theList) then
      addProp(theIndexList, theKey, [i])
      next repeat
    end if
    append(theList, i)
    setProp(theIndexList, theKey, theList)
  end repeat
  sort(theIndexList)
  return theIndexList
end

on munge theString
  set theNewString to EMPTY
  set found to 0
  repeat with i = 1 to length(theString)
    set theChar to char i of theString
    if theChar <> QUOTE then
      if theChar = TAB then
        set theChar to " "
      end if
      if (theChar <> " ") or (found = 1) then
        set found to 1
        set theNewString to theNewString & theChar
      end if
    end if
  end repeat
  return theNewString
end